home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / KEYBOARD.SWG / 0081_Keyboard Unit.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  14KB  |  693 lines
  1.  
  2. {$X+,S-,R-,I-,L-,O-,B-,D-}
  3. {*****************************************}
  4. {*  Keyboard unit for BP 7.0             *}
  5. {*  Direct INT 9h support                *}
  6. {*  Written by Alex Grischenko           *}
  7. {*  Modified by Olaf Bartelt for DPMI    *}
  8. {*  (C) AntSoft Lab , 1994               *}
  9. {*  Version 1.0 30-06-94                 *}
  10. {*****************************************}
  11.  
  12. Unit  Keyboard;
  13.  
  14. interface
  15.  
  16. type
  17.   DoubleKey = object
  18.     Left,Right : boolean;
  19.     function Both : boolean;
  20.     function Any  : boolean;
  21.   end;
  22.  
  23.   LockKey = record
  24.     Pressed,Locked : boolean;
  25.   end;
  26.  
  27.   KeyEvent = record
  28.     case Integer of
  29.      0: (KeyCode : Word);
  30.      1: (CharCode: Char; ScanCode: Byte);
  31.   end;
  32.  
  33.  
  34. const
  35.   SEG0000  : WORD = $0000;
  36.  
  37.   k_LShift = $2A00;
  38.   k_RShift = $3600;
  39.   k_LAlt   = $3800;
  40.   k_RAlt   = $3800 or $8000;
  41.   k_LCtrl  = $1D00;
  42.   k_RCtrl  = $1D00 or $8000;
  43.  
  44.   k_PrtScr     = $F900;
  45.   k_SysReg     = $F800;
  46.   k_Pause      = $F700;
  47.   k_Break      = $F600;
  48.   k_CapsLock   = $3A00;
  49.   k_NumLock    = $4500;
  50.   k_ScrollLock = $4600;
  51.  
  52.   k_AltCtrlDel = $F200;
  53.  
  54.   WasKeybEvent : boolean = false;  { Was event from keyboard }
  55.   Pressed  : boolean = false;      { TRUE - key pressed, FALSE - released }
  56.  
  57.   ESC    : boolean   = false;
  58.   Alt    : DoubleKey = ( Left : false; Right : false );
  59.   Ctrl   : DoubleKey = ( Left : false; Right : false );
  60.   Shift  : DoubleKey = ( Left : false; Right : false );
  61.   PrtScr    : boolean = false;
  62.   CapsLock  : LockKey = ( Pressed : false; Locked : false );
  63.   NumLock   : LockKey = ( Pressed : false; Locked : false );
  64.   ScrollLock: LockKey = ( Pressed : false; Locked : false );
  65.   Pause     : boolean = false;
  66.   CtrlBreak : boolean = false;
  67.  
  68.   AltCtrlDel: boolean = false;
  69.  
  70. procedure InitKeyboard;             { Initalize driver }
  71. procedure DoneKeyboard;             { Uninstall driver }
  72. function  ReadKeyboard : byte;      { Read current scancode from keyboard
  73.                                       ( }
  74. function  KeyPressed  : boolean;    { Keys was pressed?             }
  75. function  ReadKey  : char;          { For using instead CRT.ReadKey }
  76. function  ReadChar : char;          { Converts scancode to ASC-key  }
  77. procedure GetKeyEvent(var KEvent : KeyEvent);
  78.  
  79. procedure NullProc;
  80. {procedure KeybLights(On : boolean; Light : byte);}
  81.  
  82. const
  83.   AltCtrlDelproc : procedure = NullProc;
  84.   { Alt-Ctrl-Del Handler }
  85.  
  86. implementation
  87.  
  88. function DoubleKey.Both : boolean;
  89. begin
  90.   Both:=Right and Left;
  91. end;
  92.  
  93. function DoubleKey.Any : boolean;
  94. begin
  95.   Any:=Right or Left;
  96. end;
  97.  
  98. const
  99.   Key : byte = 0;
  100.   KeyboardSet : boolean = false;
  101.  
  102.   KeyCodes : array [1..$58] of word = (
  103.  
  104. {******** 85 - key **********}
  105.        {ESC  1  2  3  4  5  6  7  8  9  0  -  =  BkSp}
  106.  27, 49,50,51,52,53,54,55,56,57,48,45,61,    8,
  107.  
  108.        {TAB  Q  W  E  R  T  Y  U  I  O  P  [  ] Enter}
  109.         9,  81,87,69,82,84,89,85,73,79,80,91,93,   13,
  110.  
  111.      {LCtrl  A  S  D  F  G  H  J  K  L  ;  '  `}
  112.     k_LCtrl,65,83,68,70,71,72,74,75,76,59,39,96,
  113.  
  114.     {LShift  \  Z  X  C  V  B  N  M  ,  .  /  RShift}
  115.    k_LShift,92,90,88,67,86,66,78,77,44,46,47, k_RShift,
  116.  
  117.        { *  LAlt   Space  CapsLock}
  118.  42, k_LAlt,   32, k_CapsLock,
  119.  
  120.        {F1    F2    F3    F4    F5    F6    F7    F8    F9   F10}
  121.      $3B00,$3C00,$3D00,$3E00,$3f00,$4000,$4100,$4200,$4300,$4400,
  122.  
  123.     {  NumLock    ScrollLock}
  124.      k_NumLock, k_ScrollLock,
  125.  
  126.      {Home    Up  PgUp  K  -  Left  K  5 Right  K  +}
  127.      $4700,$4800,$4900,$4A2D,$4b00,$4c00,$4d00,$4e2b,
  128.  
  129.      { End  Down  PgDn   Ins   Del}
  130.      $4f00,$5000,$5100,$5200,$5300,
  131.  
  132. {******** 101 - key **********}
  133.     {AltPrtScr          F11     F12}
  134.          $5400, 0, 0, $5700,  $5800);
  135.  
  136.     ExtCode    : byte    = 0;
  137.     ExtExtCode : byte    = 0;
  138.     Extent     : boolean = false;
  139.  
  140. var
  141.   oldint9seg,oldint9ofs : word;
  142.   Lights : byte ;
  143. {  Queue : array[0..30] of byte;
  144. }  QHead,QTail : word;
  145.  
  146.  
  147. { - Wait keyboard }
  148. procedure WaitKeyb; near; assembler;
  149. asm
  150.    push ax
  151. @@Wait:
  152.    in   al,64h
  153.    test al,02h
  154.    loopnz @@Wait
  155.    pop  ax
  156. end;
  157.  
  158. { - Send byte to keyboard port }
  159. procedure SendIt; near; assembler;
  160. asm
  161.   cli
  162.   call WaitKeyb
  163.   out 64h,al
  164.   sti
  165. end;
  166.  
  167. procedure SetLights; near; assembler;
  168. asm
  169. (*
  170.   push ax
  171.   mov  al,0EDh
  172. {  call SendIt}
  173.   out  60h,al
  174.   mov  cx,200h
  175. @loop:
  176.   loop @loop
  177.   mov  al,Lights
  178. {  call SendIt }
  179.   out  60h,al
  180.   pop  ax
  181. *)
  182. end;
  183.  
  184.  
  185. procedure MyInt9(Flags, CS, IP, AX, BX,
  186. CX, DX, SI, DI, DS, ES, BP: Word); interrupt;
  187. label IntEnd,SendEOI;
  188. begin
  189.   asm
  190.     mov  ax, seg @data
  191.     mov  ds,ax
  192.  
  193.     mov  al,0adh   { Disable keyboard }
  194.     call sendit
  195.     cli
  196.  
  197.     call WaitKeyb  { Wait }
  198.  
  199.     in  al,60h     { Get keycode }
  200.     sti
  201.     mov key,al;
  202.  
  203. push ax
  204. mov  al,0AEh
  205. call sendit
  206. mov  al,20h
  207. out  20h,al
  208. pop  ax
  209.  
  210. @@keyEvent:
  211.     mov WasKeybEvent,1    { Set event flag }
  212.  
  213.     mov ah,al
  214.     and ah,0F0h      { Was extented keystroke ? }
  215.  
  216.     cmp ah,0E0h
  217.     jne @NormalCode
  218. (*    jne  @CheckAA    { no, check next ext. code AAh }
  219.  
  220.     cmp ExtCode,0AAh { Was sequence E0 AA E0 ? }
  221.     jne @ExtCode     { No, set as firts extent code }
  222.  
  223.     mov Extent,0     { yes, clear exten flags }
  224.     mov ExtCode,0
  225. {    mov al,91        { Return as Shift key pressed }
  226.     jmp IntEnd
  227. *)
  228.   @ExtCode:
  229.     mov Extent,1   { yes, set flag and store extented code }
  230.     mov ExtCode,al
  231.     mov WasKeybEvent,0
  232.     jmp IntEnd     { finish interrupt }
  233.  
  234.   @NormalCode:
  235.     mov ah,al
  236.     and al,7Fh     { mask low 7 bits }
  237.  
  238.     cmp al,60h
  239.     jb @@IsKey
  240.  
  241.     cmp al,0A0h
  242.     jb IntEnd
  243.  
  244. @@IsKey:
  245.     and ah,80h     { check pressing  }
  246.     je @@Pressed
  247.  
  248.     mov Pressed,0  { if higher bit set to 1, then key released }
  249.     jmp @@1
  250.  
  251.   @@Pressed:
  252.     mov Pressed,1
  253.  
  254.   @@1:
  255.     mov key,al     { store key }
  256.     mov ah,Pressed
  257.  
  258. {------------------------}
  259.     cmp al,1
  260.     jne @PrtScr
  261.     mov ESC,ah
  262.     jmp IntEnd
  263.  
  264. @PrtScr:
  265.     cmp al,37h
  266.     jne @next0
  267.     cmp ExtCode,0E0h
  268.     jne IntEnd
  269.     mov PrtScr,ah
  270.  
  271. @next0:
  272.     cmp al,2ah
  273.     jne @next1
  274.     cmp ExtCode,0E0h
  275.     jne @ShiftL
  276. @ExtShift:
  277.     xor ax,ax
  278.     mov WasKeybEvent,al
  279.     mov ExtCode,al
  280.     mov key,al
  281.     jmp IntEnd
  282. @ShiftL:
  283.     mov Shift.Left,ah
  284.     jmp IntEnd
  285.  
  286. @next1:
  287.     cmp al,36h
  288.     jne @next2
  289.     cmp ExtCode,0E0h
  290.     je  @ExtShift
  291.     mov Shift.Right,ah
  292.     jmp IntEnd
  293.  
  294. @next2:
  295.     cmp al,38h
  296.     jne @next3
  297.     cmp ExtCode,0E0h
  298.     je  @RAlt
  299.     mov Alt.Left,ah
  300.     jmp IntEnd
  301.   @Ralt:
  302.     mov Alt.Right,ah
  303.     jmp @@ResetExt
  304.  
  305.  
  306. @next3:
  307.     cmp al,1Dh
  308.     jne @next4
  309.     cmp ExtCode,0E0h
  310.     je  @RCtrl
  311.     mov Ctrl.Left,ah
  312.     jmp IntEnd
  313.   @RCtrl:
  314.     mov Ctrl.Right,ah
  315.     jmp @@ResetExt
  316.  
  317. @next4:
  318.     cmp al,3ah
  319.     jne @next5
  320.     mov CapsLock.Pressed,ah
  321.     cmp ah,1
  322.     je  IntEnd
  323.     xor CapsLock.Locked,1
  324.     xor Lights,4
  325.     mov ax,0AEh
  326. {    call SendIt}
  327.     call SetLights
  328.     jmp SendEOI
  329.  
  330. @next5:
  331.     cmp al,45h
  332.     jne @next6
  333.     mov NumLock.Pressed,ah
  334.     cmp ah,1
  335.     je  IntEnd
  336.     xor NumLock.Locked,1
  337.     xor Lights,2
  338.     mov ax,0AEh
  339. {    call SendIt  }
  340.     call SetLights
  341.     jmp SendEOI
  342.  
  343. @next6:
  344.     cmp al,46h
  345.     jne @next7
  346.     mov ScrollLock.Pressed,ah
  347.     cmp ah,1
  348.     je  IntEnd
  349.     xor ScrollLock.Locked,1
  350.     xor Lights,1
  351.     mov ax,0AEh
  352.  {   call SendIt}
  353.     call SetLights
  354.     jmp SendEOI
  355.  
  356. @@ResetExt:
  357.     xor ax,ax
  358.     mov ExtCode,al
  359.     mov Extent,al
  360.     jmp IntEnd
  361.  
  362. @next7:
  363.     cmp al,53h
  364.     jne IntEnd
  365.   end;
  366.  
  367.   AltCtrlDel:=pressed and Alt.Any and Ctrl.Any;
  368.  
  369.   if AltCtrlDel then AltCtrlDelProc;
  370.  
  371. IntEnd:
  372. asm
  373. { Interrupt end }{
  374.     mov  al,0aeh
  375.     call sendit   }
  376. SendEOI:           {
  377.     mov  al,20h
  378.     out  20h,al     }
  379.   end;
  380. end;
  381.  
  382.  
  383. procedure InitKeyboard; assembler;
  384. asm
  385.    cmp KeyboardSet,0
  386.    jne @@Quit
  387.  
  388. @ClearBufferLoop:
  389.    mov ah,1
  390.    int 16h
  391.    jz  @NoKeyb
  392.    xor ax,ax
  393.    int 16h
  394.    jmp @ClearBufferLoop
  395.  
  396. @NoKeyb:
  397.    mov ax,3509h
  398.    int 21h
  399.    mov oldint9seg,es
  400.    mov oldint9ofs,bx
  401.  
  402.    push ds
  403.  
  404.    push cs
  405.    pop  ds
  406.    mov  ax,2509h
  407.    mov  dx,offset MyInt9
  408.    int  21h
  409.    pop  ds
  410.  
  411.    cli
  412.    xor  ax,ax
  413.    mov  QHead,ax
  414.    mov  QTail,ax
  415.    mov  Key,al
  416.  
  417.    xor  ax,ax
  418.    mov  es,SEG0000
  419.    mov  al,byte ptr es:[417h]
  420.    mov  cl,4
  421.    shr  al,cl
  422.    mov  Lights,al
  423.  
  424.    mov  KeyboardSet,1
  425.    sti
  426. @@Quit:
  427. end;
  428.  
  429. procedure DoneKeyboard; assembler;
  430. asm
  431.    cmp  KeyboardSet,0
  432.    je   @@Quit
  433.    xor  ax,ax
  434.    mov  es,SEG0000
  435.    mov  ax,word ptr es:[417h]
  436.    mov  bl,Lights
  437.    mov  cl,4
  438.    shl  bl,cl
  439.    and  al,10001111b  { Set Lights status }
  440.    or   al,bl
  441.    and  ax,111110011110000b
  442.    mov  word ptr es:[417h],ax
  443.  
  444.  
  445.    push ds
  446.    mov  dx,oldint9ofs
  447.    mov  ax,oldint9seg
  448.    mov  ds,ax
  449.    mov  ax,2509h
  450.    int  21h
  451.    pop  ds
  452. @@Quit:
  453. end;
  454.  
  455. function ReadKeyboard : byte; Assembler;
  456. asm
  457.   xor  ax,ax
  458.   mov  al,Key;
  459.   mov  Key,ah;
  460.   mov  WasKeybEvent,ah
  461. end;
  462.  
  463. function KeyPressed : boolean;
  464. begin
  465.   KeyPressed:=WasKeybEvent and Pressed;
  466. end;
  467.  
  468. function ReadKey : char;
  469. begin
  470.   if KeyboardSet then
  471.   begin
  472.  
  473.   end
  474.   else begin
  475.     Writeln(#7'KEYBOARD.TPU Error : use InitKeyboard first!');
  476.     halt;
  477.   end;
  478. end;
  479.  
  480. function ReadChar : char; assembler;
  481. const
  482.   scancode : char = #0;
  483. asm
  484.   cmp ScanCode,0     { if were extented keystrokes }
  485.   je  @@NoScanCode
  486.  
  487.   mov al,ScanCode    { then return scan code }
  488.   mov ScanCode,0
  489.   jmp @@Quit
  490.  
  491. @@NoScanCode:
  492.   mov al,0
  493.   cmp Key,0
  494.   je  @@Quit
  495.  
  496.   mov bh,al
  497.   mov bl,Key
  498.   dec bl
  499.   shl bx,1
  500.   mov ax,[offset KeyCodes + bx]
  501.  
  502.   cmp al,0
  503.   jne @@Quit
  504.  
  505.   mov ScanCode,ah
  506. @@Quit:
  507.   mov key,0
  508. end;
  509.  
  510. procedure GetKeyEvent( var KEvent : KeyEvent); assembler;
  511. asm
  512.   les di,KEvent
  513.   mov word ptr es:[di],0
  514.   cmp WasKeybEvent,0
  515.   je  @Quit
  516.  
  517.   xor bx,bx
  518.   mov bl,key
  519.   dec bx
  520.   shl bx,1
  521.   mov ax,[offset KeyCodes + bx]
  522.  
  523.   cmp al,0
  524.   je  @Store
  525.  
  526.   mov ah,key
  527. @Store:
  528.   mov word ptr es:[di],ax
  529.   mov WasKeybEvent,0
  530.   mov Key,0
  531. @Quit:
  532. end;
  533.  
  534. {-------------------------------}
  535. procedure KeybLights(On : boolean; Light : byte);
  536. var L : byte;
  537. begin
  538.   if (Light>7) then exit;
  539.   asm
  540.     mov al,0EDh
  541.     out 60h,al
  542.     mov cx,2000h
  543.   @loop:
  544.     loop @loop
  545.   end;
  546.   if On then L := Lights or  Light
  547.         else L := Lights and not Light;
  548.   port[$60]:=L;
  549. end;
  550.  
  551. {-------------------------------}
  552. procedure NullProc;
  553. begin
  554. end;
  555.  
  556. var OldExitProc : pointer;
  557.  
  558. procedure ExitProcedure; far;
  559. begin
  560.   DoneKeyboard;
  561.   ExitProc:=OldExitProc;
  562. end;
  563.  
  564. FUNCTION  get_selector(segment : WORD) : WORD;
  565. VAR selector : WORD;
  566. BEGIN
  567.   {$IFDEF DPMI}
  568.   ASM
  569.     MOV AX, $0002
  570.     MOV BX, segment
  571.     INT $31
  572.     JNC @@1
  573.     MOV AX, segment
  574. @@1:
  575.     MOV selector, AX
  576.   END;
  577.   {$ELSE}
  578.   selector := segment;
  579.   {$ENDIF}
  580.  
  581.   get_selector := selector;
  582. END;
  583.  
  584. begin
  585.   SEG0000 := get_selector($0000);
  586.   OldExitProc:=ExitProc;
  587.   ExitProc:=@ExitProcedure;
  588. end.
  589.  
  590. { ---------------------------  DEMO ------------------------------ }
  591.  
  592. program KeybDemo;
  593. { Copyright (c) 1994 by Andrew Eigus   Fidonet: 2:5100/33 }
  594.  
  595. uses Crt, Keyboard;
  596.  
  597. const
  598.   Status : array[Boolean] of String[11] = ('Not pressed', 'Pressed    ');
  599.   Lock : array[Boolean] of String[10] = ('Not locked', 'Locked    ');
  600.  
  601. var
  602.   key : KeyEvent;
  603.   ch : char;
  604.   CursorShape : word;
  605.  
  606. Procedure SetCursor(CursorOnOff : boolean); assembler;
  607. Asm
  608.   CMP CursorOnOff,True
  609.   JNE @@2
  610.   CMP BYTE PTR [LastMode],Mono
  611.   JE  @@1
  612.   MOV CX,0607h
  613.   JMP @@4
  614. @@1:
  615.   MOV CX,0B0Ch
  616.   JMP @@4
  617. @@2:
  618.   CMP BYTE PTR [LastMode],Mono
  619.   JE  @@3
  620.   MOV CX,2000h
  621.   JMP @@4
  622. @@3:
  623.   XOR CX,CX
  624. @@4:
  625.   MOV AH,01h
  626.   XOR BH,BH
  627.   INT 10h
  628. End; { SetCursor }
  629.  
  630. procedure AltCtrlDelp; far;
  631. begin
  632.   Writeln(#13#10#10'That was it. Not bad, eh?');
  633.   SetCursor(True);
  634.   Halt(1)
  635. end;
  636.  
  637. Procedure WriteXY(X, Y : byte; S : string);
  638. Begin
  639.   GotoXY(X, Y);
  640.   Write(S)
  641. End; { WriteXY }
  642.  
  643. Function Hex(W : Word) : string;
  644. const hexChars: array [0..$F] of Char = '0123456789ABCDEF';
  645. Begin
  646.   Hex[0] := #4;
  647.   Hex[1] := hexChars[Hi(W) shr 4];
  648.   Hex[2] := hexChars[Hi(W) and $F];
  649.   Hex[3] := hexChars[Lo(W) shr 4];
  650.   Hex[4] := hexChars[Lo(W) and $F]
  651. End; { Hex }
  652.  
  653. Begin
  654.   InitKeyboard;
  655.   AltCtrlDelproc:=AltCtrlDelp;
  656.   SetCursor(False);
  657.   TextAttr := LightGray;
  658.   ClrScr;
  659.   WriteLn('Keyboard unit demo  by Andrew Eigus (c) 1994   Fidonet: 2:5100/33');
  660.   WriteLn('Hit any key to scan or Ctrl-Alt-Del to quit.');
  661.   repeat
  662.     GetKeyEvent(Key);
  663.  
  664.     WriteXY(1, 5, 'Left Shift state  : ' + Status[Shift.Left]);
  665.     WriteXY(35, 5, 'Right Shift state  : ' + Status[Shift.Right]);
  666.     WriteXY(1, 6, 'Left Alt state    : ' + Status[Alt.Left]);
  667.     WriteXY(35, 6, 'Right Alt state    : ' + Status[Alt.Right]);
  668.     WriteXY(1, 7, 'Left Ctrl state   : ' + Status[Ctrl.Left]);
  669.     WriteXY(35, 7, 'Right Ctrl state   : ' + Status[Ctrl.Right]);
  670.     WriteXY(1, 9, 'Scroll Lock state : ' + Status[ScrollLock.Pressed]);
  671.     WriteXY(35, 9, 'Scroll Lock toggle : ' + Lock[ScrollLock.Locked]);
  672.     WriteXY(1, 10, 'Num Lock state    : ' + Status[NumLock.Pressed]);
  673.     WriteXY(35, 10, 'Num Lock toggle    : ' + Lock[NumLock.Locked]);
  674.     WriteXY(1, 11, 'Caps Lock state   : ' + Status[CapsLock.Pressed]);
  675.     WriteXY(35, 11, 'Caps Lock toggle   : ' + Lock[CapsLock.Locked]);
  676.     WriteXY(1, 13, 'PrtScr key state : ' + Status[PrtScr]);
  677.     if Key.ScanCode and $F0 = $E0 then
  678.       WriteXY(1, 15, 'Key code        : ' + Hex(Key.ScanCode))
  679.     else
  680.     begin
  681.       WriteXY(1, 16, 'Scan code       : ' +
  682.         Hex(Key.ScanCode and $7F) + ',' + Hex(Key.ScanCode and $7F));
  683.       WriteXY(35, 16, 'Key state      : ' + Status[Pressed])
  684.     end;
  685.  
  686.     WriteXY(1, 17, 'Key ASCII code      : "' +
  687.       Key.CharCode + '",' + Hex(Byte(Key.CharCode)));
  688.  
  689.     repeat until WasKeybEvent
  690.   until False
  691. End.
  692.  
  693.